﻿Imports System.Text.RegularExpressions

'******************************************************
'******************************************************
'Application Title: Google Widget Editor
'version: 1.0
'Date: 01-02-2008
'Requirements: win2k or later
'Author: Andrew Pye
'Author Email: StretchMasterP@googlemail.com
'License: Released under GNU GENERAL PUBLIC LICENSE v3
'ToDo:
'Changes:Imports System.Text
'******************************************************
'******************************************************
Public Class ClassCodeColor
    Private WithEvents _CodeEdit As RichTextBox
    'Private Declare Auto Function SendScrollPosMessage _
    '            Lib "user32.dll" Alias "SendMessage" ( _
    '            ByVal hWnd As IntPtr, _
    '            ByVal Msg As Integer, _
    '            ByVal wParam As IntPtr, _
    '            ByRef lParam As Point) As Integer
    'Private Const WM_USER = &H400
    'Private Const EM_GETSCROLLPOS = WM_USER + 221
    'Private Const EM_SETSCROLLPOS = WM_USER + 222
    'Private aControls As New ArrayList

    Public Property CodeEdit()
        Get
            Return _CodeEdit
        End Get
        Set(ByVal value)
            _CodeEdit = value
        End Set
    End Property
    ''' <summary>
    ''' Header of the rtf
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function GetRTFHeader()
        Dim strBuf As String = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fmodern\fprq1\fcharset0 Courier New;}{\f1\fswiss\fcharset0 Arial;}}" _
        & "{\colortbl ;\red0\green128\blue0;\red0\green0\blue255;\red50\green0\blue255;}" _
        & "{\*\generator Msftedit 5.41.21.2500;}\viewkind4\uc1\pard\f0\fs20 "
        Return strBuf
    End Function
    ''' <summary>
    ''' Footer of the rtf
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function GetRTFFoolter()
        Dim strBuf As String = "}"
        Return strBuf
    End Function
    ''' <summary>
    ''' Color the code
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub ColorCode()
        Dim SrBar As ScrollBarRestore
        ModWindowUpdate.LockWindowUpdate(_CodeEdit.Handle)
        Dim SelStart As Integer = _CodeEdit.SelectionStart
        Dim SelLen As Integer = _CodeEdit.SelectionLength
        Dim IsInScriptTag As Boolean = False
        '  Dim ScrollOff As Point = 

        Dim MultiRem As Boolean = False
        Dim StrBuf(_CodeEdit.Lines.Length - 1) As String
        Dim Bstr As String = ""
        SrBar = New ScrollBarRestore
        SrBar.GetScroll(Me._CodeEdit.Handle)
        For i As Integer = 0 To _CodeEdit.Lines.Length - 1
            If IsInScriptTag = True Then
                If _CodeEdit.Lines(i).ToString.Trim.StartsWith("//") Or _
                _CodeEdit.Lines(i).ToString.Trim.StartsWith("<!--") Or MultiRem = True Then
                    If _CodeEdit.Lines(i).ToString.Trim.EndsWith("*/") And MultiRem = True Or _CodeEdit.Lines(i).ToString.Trim.StartsWith("*/") And MultiRem = True Then
                        StrBuf(i) = "\cf1 " & Me.EscapeChars(_CodeEdit.Lines(i)) & "\cf0\par"
                        MultiRem = False
                    Else
                        StrBuf(i) = "\cf1 " & Me.EscapeChars(_CodeEdit.Lines(i)) & "\cf0\par"
                    End If
                ElseIf _CodeEdit.Lines(i).ToString.Trim.StartsWith("/*") And _CodeEdit.Lines(i).ToString.Trim.Contains("*/") = False Then
                    StrBuf(i) = "\cf1 " & Me.EscapeChars(_CodeEdit.Lines(i)) & "\cf0\par"
                    MultiRem = True
                ElseIf _CodeEdit.Lines(i).ToString.Trim.StartsWith("/*") And _CodeEdit.Lines(i).ToString.Trim.Contains("*/") Then
                    StrBuf(i) = "\cf1 " & Me.EscapeChars(_CodeEdit.Lines(i)) & "\cf0\par"
                    MultiRem = False
                ElseIf _CodeEdit.Lines(i).ToString.Trim.Contains("</script") Then
                    IsInScriptTag = False
                    StrBuf(i) = Me.EscapeChars(_CodeEdit.Lines(i)) & "\par"
                Else
                    StrBuf(i) = KeyWordsColor(Me.EscapeChars(_CodeEdit.Lines(i))) & "\par"
                    StrBuf(i) = FunctionColor(StrBuf(i))
                End If
            Else
                If _CodeEdit.Lines(i).ToString.Trim.Contains("<script") And _CodeEdit.Lines(i).ToString.Trim.Contains("</script") = False Then
                    IsInScriptTag = True
                    StrBuf(i) = Me.EscapeChars(_CodeEdit.Lines(i)) & "\par"
                Else
                    StrBuf(i) = Me.EscapeChars(_CodeEdit.Lines(i)) & "\par"
                End If
            End If
        Next
        For Each Tobj As String In StrBuf
            Bstr = Bstr & Tobj & ControlChars.NewLine
        Next
        '=======
        'Restore
        '=======
        _CodeEdit.Rtf = ""
        _CodeEdit.Rtf = GetRTFHeader() & Bstr & GetRTFFoolter()
        _CodeEdit.SelectionStart = SelStart
        _CodeEdit.SelectionLength = SelLen
        _CodeEdit.AutoScrollOffset = New Point(100, 100)
        SrBar.SetScroll(Me._CodeEdit.Handle)
        SrBar = Nothing
        ModWindowUpdate.LockWindowUpdate(0)
    End Sub
    Private Function EscapeChars(ByVal Data As String) As String
        Dim strbuf As String = Data
        strbuf = strbuf.Replace("{", "\{")
        strbuf = strbuf.Replace("}", "\}")
        ' If Data.StartsWith(ControlChars.Tab) Then Stop
        strbuf = strbuf.Replace(ControlChars.Tab, "\tab ")
        Return strbuf
    End Function
    Private Function GetScrollPos()
        Dim scrollPoint As Point = New Point()

        Return scrollPoint
    End Function
    Private Function KeyWordsColor(ByVal Code As String) As String
        Dim strbuf As String = Code
        'Escape the {

        Dim KeyWords() = {"abstract", "boolean", "break", "byte", "case", "catch", "char", "class", "const", "continue", "debugger", "default", "delete", "do", "double", "else", "enum", "export", "extends", "false", "final", "finally", "float", "for", "function", "goto", "if", "implements", "import", "in", "instanceof", "int", "interface", "long", "native", "new", "null", "package", "private", "protected", "public", "return", "short", "static", "super", "switch", "synchronized", "this", "throw", "throws", "transient", "true", "try", "typeof", "var", "void", "volatile", "while", "with"}
        For Each Tobj As String In KeyWords
            'If Tobj = "if" Then Stop
            If strbuf.ToLower.Contains(" " & Tobj.ToLower & " ") Then
                Dim spos As Integer = strbuf.IndexOf(Tobj)
                Dim TStr As String = strbuf.ToLower.Substring(spos + Tobj.Length, 1)
                Select Case TStr
                    Case "(", "\"
                        strbuf = Replace(strbuf, " " & Tobj & " ", "\cf2  " & Tobj & " \cf0 ", , , CompareMethod.Text)
                    Case " "
                        strbuf = Replace(strbuf, " " & Tobj & " ", "\cf2  " & Tobj & " \cf0 ", , , CompareMethod.Text)
                        'strbuf = Replace(strbuf, Tobj, "\cf2" & Tobj & "\cf0 ", , , CompareMethod.Text)
                End Select

            ElseIf strbuf.ToLower.StartsWith(Tobj.ToLower) Then
                Dim TStr As String = strbuf.ToLower.Substring(Tobj.Length, 1)
                Select Case TStr
                    Case "(", "\"
                        strbuf = Replace(strbuf, Tobj, "\cf2" & Tobj & "\cf0", , , CompareMethod.Text)
                    Case " "
                        strbuf = Replace(strbuf, Tobj, "\cf2" & Tobj & "\cf0 ", , , CompareMethod.Text)
                End Select
            ElseIf strbuf.ToLower.StartsWith(Tobj.ToLower & " ") Then
                strbuf = Replace(strbuf, Tobj, "\cf2" & Tobj & "\cf0  ", , , CompareMethod.Text)
            ElseIf strbuf.ToLower.EndsWith(" " & Tobj.ToLower) Then
                strbuf = Replace(strbuf, Tobj, "\cf2  " & Tobj & " \cf0", , , CompareMethod.Text)
            End If
        Next
        Return strbuf
    End Function
    Private Function FunctionColor(ByVal Code As String) As String
        Dim strbuf As String = Code
        Dim KeyWords() = {"_IG_registerOnLoadHandler"}

        For Each Tobj As String In KeyWords
            If strbuf.ToLower.Contains(Tobj.ToLower) Then
                strbuf = Replace(strbuf, Tobj, "\cf2 " & Tobj & " \cf0", , , CompareMethod.Text)
            End If
        Next
        Return strbuf
    End Function
    Private Sub _CodeEdit_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles _CodeEdit.KeyDown
        If e.KeyCode = Keys.Return Then
            Me.ColorCode()
        End If
    End Sub


End Class
